perm filename G[X,ALS] blob sn#075320 filedate 1973-12-05 generic text, type T, neo UTF8
00010	ENTRY PREPARE;
00020	BEGIN
00030	DEFINE ⊂="COMMENT",CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00040	EXTERNAL REAL ARRAY C,D[0:512];
00050	EXTERNAL INTEGER ARRAY INNAME,INDATA[0:32];
00060	INTEGER F1_LOW,F1_HI,F2_LOW,F2_HI,F3_LOW,F3_HI,F4_LOW,F4_HI,F5_LOW;
00067	INTEGER F5_HI,NP_LOW,NP_HI,NZ_LOW,NZ_HI,FP1_LO,FP1_H,FP2_LO,FP2_H;
00072	INTEGER I,J,K,P;
00077	EXTERNAL INTEGER F1,F2,F3,F4,F5,NP,NZ,FP1,FP2;
00080	
00090	
00100	
00110	
01000	PROCEDURE DEFINES;
01010	BEGIN
01020		F1_LOW←  200 * 256%10000;  F1_HI←  800 * 256%10000;
01030		F2_LOW←  800 * 256%10000;  F2_HI← 2050 * 256%10000;
01040		F3_LOW← 2000 * 256%10000;  F3_HI← 3200 * 256%10000;
01045		F4_LOW← 2700 * 256%10000;  F4_HI← 4000 * 256%10000;
01047		F5_LOW← 3600 * 256%10000;  F5_HI← 5400 * 256%10000;
01050	
01060		FP1_LO← 1800 * 256%10000;  FP1_H← 3200 * 256%10000;
01070		FP2_LO← 3200 * 256%10000;  FP2_H← 5000 * 256%10000;
01080	
01090	
01100		NP_LOW←  800 * 256%10000;  NP_HI← 1500 * 256%10000;
01110		NZ_LOW←NP-500* 256%10000;  NZ_HI←NP+500* 256%10000;
01120	END;
01130	
01140	
02000	INTEGER PROCEDURE PEAK (INTEGER LOW,HIGH);
02010	BEGIN
02020	  INTEGER I,J;  REAL MAX;
02030	
02040	  MAX←-10000;
02050	
02060	  FOR I←LOW STEP 1 UNTIL HIGH DO
02070	    IF C[I]>MAX THEN BEGIN  MAX←C[I]; J←I; END;
02080	
02090	   IF J=LOW THEN BEGIN
02100	    MAX←-10000;
02110	    FOR I←LOW+1 STEP 1 UNTIL HIGH DO
02120	      IF C[I]>C[I-1] THEN BEGIN  MAX←C[I]; J←I; END;
02130	    IF MAX=-10000 THEN J←-1;  ⊂ No proper peak has been found;
02140	    END;
02150	
02160	  IF J=HIGH THEN BEGIN
02170	    MAX←-10000;
02180	    FOR I←HIGH-1 STEP -1 UNTIL LOW DO
02190	      IF C[I]>C[I+1] THEN BEGIN  MAX←C[I]; J←I; END;
02200	    IF MAX←-10000 THEN J←-2;  ⊂ No proper peak has been found;
02210	    END;
02240	
02250	  RETURN(J);
02260	END;
02270	
03000	PROCEDURE FORMANT;
03010	BEGIN
03020	
03030	IF INFLAG=0 THEN BEGIN
03035	
03040		INNAME[P]←CVASC("F1");	P←P+1;
03050		INNAME[P]←CVASC("F2");	P←P+1;
03060		INNAME[P]←CVASC("F3");	P←P+1;
03070	
03080		INNAME[P]←CVASC("A1");	P←P+1;
03090		INNAME[P]←CVASC("A2");	P←P+1;
03100		INNAME[P]←CVASC("A3");	P←P+1;
03110	
03120	  END ELSE BEGIN
03130	
03140	  F1←PEAK(F1_LOW,F1_HI);
03150	  F2←PEAK(F2_LOW,F2_HI);
03160	  F3←PEAK(F3_LOW,F3_HI);
03170	
03180	  IF F2=F1 THEN BEGIN  F2←PEAK(F1_HI,F2_HI);
04999	
05000	INTERNAL PROCEDURE PREPARE;
05100	BEGIN
05200	OUTSTR("This is a dummy PREPARE package"&CRLF);
05300	END;
05310	
05320	END;
05400